home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / The Best of BMUG / Utilities / Text and Speech / Alpha.5.76 / Tcl / SystemCode / flags.tcl < prev    next >
Text File  |  1994-03-11  |  3KB  |  143 lines
  1.  
  2. set flagFlags ""
  3.  
  4. # The following three procs, together w/ the initialization 
  5. # for the flags below, allow a totally Tcl-controlled menu to 
  6. # shadow Alpha's internal variables.
  7. proc initFlag var {
  8.     global $var flagFlags
  9.     addMenuItem -m Flags $var
  10.     linkVar $var
  11.     lappend flagFlags $var
  12. }
  13.  
  14. # Called for ordinary tcl global vars we want included in the Flags menu.
  15. proc initTclFlag {flag {val 0}} {
  16.     global $flag flagFlags
  17.     addMenuItem -m Flags $flag
  18.     if {![info exists $flag]} {set $flag $val}
  19.     lappend flagFlags $flag
  20. }
  21.  
  22. # Called for ordinary tcl global vars we want included in the Vars menu.
  23. proc initTclVar {var {val ""}} {
  24.     global $var
  25.     if {[string length $val]} {
  26.         set $var $val
  27.     }
  28.     addMenuItem -m Vars $var
  29.     if {![info exists $var]} {set $var 0}
  30. }
  31.  
  32.  
  33. # 'fullNames' needs to be traced to update win menu.
  34. if {![info exists oldFNames]} {set oldFNames 0}
  35. proc shadowFullNames args {
  36.     global winNameToNum fullNames oldFNames winMenu
  37.     
  38.     if {$fullNames == $oldFNames} {return $fullNames}
  39.     set oldFNames $fullNames
  40.     
  41.     if {[catch {set nms [array names winNameToNum]}] == "1"} {
  42.         return $fullNames
  43.     }
  44.     
  45.     if {$fullNames == "1"} {
  46.         foreach name $nms {
  47.             if {$winNameToNum($name) < 10} {
  48.                 set lab /$winNameToNum($name)
  49.             } else {set lab ""}
  50.             regexp {[^:]*$} $name nm
  51.             catch {deleteMenuItem -m $winMenu $nm}
  52.             addMenuItem -m -l $lab $winMenu $name
  53.         }
  54.     } else {
  55.         foreach name $nms {
  56.             if {$winNameToNum($name) < 10} {
  57.                 set lab /$winNameToNum($name)
  58.             } else {set lab ""}
  59.             regexp {[^:]*$} $name nm
  60.             catch {deleteMenuItem -m $winMenu $name}
  61.             addMenuItem -m -l $lab $winMenu $nm
  62.         }
  63.     }
  64.     return $fullNames
  65. }
  66.  
  67. proc initVar var {
  68.     global $var
  69.     linkVar $var
  70.     addMenuItem -m Vars $var
  71. }
  72.  
  73. # This file contains methods allowing the shadowing of tcl variables 
  74.  
  75. initFlag autoHScroll
  76. initFlag autoSave
  77. initTclFlag backup
  78. initFlag blockCursor
  79. initFlag bwWindows
  80. initFlag dragAndDrop
  81. initFlag elecLBrace
  82. initFlag elecRBrace
  83. initFlag electricSemi
  84. initFlag fullNames
  85. trace vdelete fullNames w shadowFullNames
  86. trace variable fullNames w shadowFullNames
  87. initFlag fullScreen
  88. initFlag horScrollBar
  89. initTclFlag iconifyOnSwitch
  90. initFlag indentOnCR
  91. initTclFlag intelCutPaste 1
  92. initFlag moveInsertion
  93. initFlag openAllFiles
  94. initFlag optionIsMeta
  95. initFlag posActivate
  96. initFlag powerThumb
  97. initFlag projectorAware
  98. initFlag showRowCol
  99. initFlag showInvisibles
  100. initFlag showMenuHeads
  101. initFlag sortedIsDefault
  102. initFlag suppressHeader
  103. initFlag tempMem
  104. initFlag undoOn
  105. initFlag wordWrap
  106.  
  107. initTclVar backExtension "~"
  108. initTclVar backDir
  109. initVar bottomMargin
  110. initVar changesLim
  111. initVar defHeight
  112. initVar defWidth
  113. initVar defaultFont
  114. initVar fillColumn
  115. initVar fontSaving
  116. initVar fontSize
  117. initVar funcExpr
  118. initVar funcPar
  119. initVar leftFillColumn
  120. initVar leftMargin
  121. initVar markLabel
  122. initVar markSorting
  123. initVar numWinsToTile
  124. initVar paraColumn
  125. initVar    printerFont
  126. initVar    printerFontSize
  127. initVar savedState
  128. initVar sortColumn
  129. initVar tabSize
  130. initVar tagFile
  131. initVar topMargin
  132. initVar wordBreak
  133. initVar wordBreakPreface
  134.  
  135. # Redefine 'menuHook' to update flags menu.
  136. proc menuHook {} {
  137.     uplevel #0 {
  138.         foreach f $flagFlags {
  139.             markMenuItem Flags $f [set $f]
  140.         }
  141.     }
  142. }
  143.